Programming Microsoft Visual Basic .NET/Programming Microsoft Visual Basic .NET (Microsoft Press)(X08-78517)(2002).bin/06 interfaces and delegates/delegatedemo/module1.vb

Text File | 2002-03-16 | 9.5 KB | 255 lines

Module Module1

    Sub Main()
        ' Run one of the Textxxxx procedures below by uncommenting only one statement

        'TestFirstDelegate()
        'TestLogDelegate()
        'TestMultiCastDelegate()
        'TestMulticastWithFunctions()
        'TestCallbacks()
        'TestAPICallback()

        ' You need these statements when running inside Visual Studio, so that
        ' the Console window doesn't disappear
        Console.WriteLine("")
        Console.WriteLine(">>> press Enter to terminate the program <<<")
        Console.ReadLine()
    End Sub

    Delegate Sub OneArgSub(ByVal msg As String)

    Event LogToFile As LogWriter

    ' this procedure tests a simple delegate
    Sub TestFirstDelegate()
        ' declare and create the delegate
        Dim deleg As OneArgSub
        deleg = New OneArgSub(AddressOf DisplayMsg)

        ' This statement displays the "FooBar" string in the Console window.
        deleg.Invoke("FooBar")                      ' => FooBar

        ' repeate the Invoke, this time displaying the message in a message box.
        ' note that we use the shortened syntax to create the delegate
        deleg = AddressOf PopupMsg
        deleg.Invoke("FooBar")
    End Sub

    ' Display a string in the Output window.
    Sub DisplayMsg(ByVal msgText As String)
        Console.WriteLine(msgText)
    End Sub

    ' Display a string in a popup message box.
    Sub PopupMsg(ByVal msgText As String)
        Microsoft.VisualBasic.MsgBox(msgText)
    End Sub

    Delegate Function One() As Integer

    Function FnOne() As Integer
        Static counter As Integer
        counter += 1
        Debug.WriteLine("FnOne")
        Return counter
    End Function

    ' Test that you can do logging to the console or a file, depending
    ' on a switch passed on the command line

    ' Define the delegate variable.
    Delegate Sub LogWriter(ByVal Msg As String)
    ' this is an instance of our class
    Dim log As LogWriter
    ' Define a stream writer.
    Dim fw As System.IO.StreamWriter

    Sub TestLogDelegate()
        ' Get command line arguments.
        Dim args() As String = Environment.GetCommandLineArgs

        If args.Length > 1 Then
            ' If the command line contains a file name, open that file.
            fw = New System.IO.StreamWriter(args(1))
            ' Have the delegate point to the stream's WriteLine method.
            log = New LogWriter(AddressOf fw.WriteLine)
        Else
            ' If no argument has been specified, send to the console.
            log = New LogWriter(AddressOf Console.WriteLine)
        End If

        ' use the Method name and reflection to display info on the target method.
        Console.WriteLine("Target method: " & log.Method.Name)

        Call DoTheRealJob()

        ' This is necessary to flush the output buffer.
        If Not (fw Is Nothing) Then fw.Close()
    End Sub

    ' a sample routine that uses tracing
    Sub DoTheRealJob()
        log("Start of program")
        ' ....
        log("In the middle of the program.")
        ' ...
        log("End of program")
    End Sub

    ' this procedure tests a multicast delegate - it displays a trace message
    ' to the Console *and* to a file (if an argument is passed on the
    ' command line)

    Sub TestMultiCastDelegate()
        ' Always log to the Console.
        log = AddressOf Console.WriteLine
        ' Define another delegate
        Dim log2 As LogWriter

        ' Get command line arguments.
        Dim args() As String = Environment.GetCommandLineArgs

        If args.Length > 1 Then
            ' The command line contains a file name.
            fw = New System.IO.StreamWriter(args(1))
            ' Create a second delegate that points to the stream's WriteLine method.
            log2 = AddressOf fw.WriteLine
            ' combine it with the existing delegate.
            log = DirectCast(log.Combine(log, log2), LogWriter)
        End If

        Call DoTheRealJob()

        ' This is necessary to flush the output buffer.
        If Not (fw Is Nothing) Then fw.Close()

        ' List the names of all the target methods.
        Console.WriteLine("")
        Console.WriteLine("List of target methods:")

        ' List all the delegates in a multi-cast delegate.
        ' (Note that Delegate is a reserved word and must be enclosed in square brackets.)
        Dim delegs() As [Delegate] = log.GetInvocationList

        ' Get the list of individual delegates in a multi-cast delegates.
        Dim d As [Delegate]
        For Each d In delegs
            Console.WriteLine(d.Method.Name)
        Next

        ' Change the log delegate so that it doesn't log to file any longer.
        log = DirectCast(log.Remove(log, log2), LogWriter)
        ' This method only display a log message to the console.
        log("Application ended")
    End Sub

    ' this procedure shows that it is possible to call functions
    ' through multicast delegates

    Sub TestMulticastWithFunctions()
        Dim d As New One(AddressOf FnOne)
        Dim d2 As New One(AddressOf FnOne)
        d = DirectCast(d.Combine(d, d2), One)

        Debug.WriteLine(d.Invoke)
    End Sub

    ' this procedure show how to use delegates for callbacks

    Sub TestCallbacks()
        ' print the names of all directories under c:\Docs
        TraverseDirectoryTree("C:\DOCS", AddressOf DisplayDirectoryName)
    End Sub

    ' a function that complies with the TraverseDirectoryTree_CBK syntax
    Function DisplayDirectoryName(ByVal path As String) As Boolean
        Console.WriteLine(path)
        If path = "C:\DOCS\LIBRI\OOP" Then Return True
    End Function

    ' a delegate that defines the syntax of the function whose address
    ' can be passed to TraverseDirectoryTree - if this function returns True
    ' then the enumeration should be stopped
    Delegate Function TraverseDirectoryTree_CBK(ByVal dirName As String) As Boolean

    ' a reusable procedure that traverse a directory tree and calls back the caller
    ' for each new directory
    Sub TraverseDirectoryTree(ByVal path As String, ByVal callback As TraverseDirectoryTree_CBK)
        Dim dirName As String
        Static nestLevel As Integer       ' nesting nestLevel
        Static isCanceled As Boolean      ' True if the client isCanceled the enumeration

        nestLevel += 1

        For Each dirName In System.IO.Directory.GetDirectories(path)
            ' call back the program to notify this directory
            isCanceled = callback.Invoke(dirName)
            If isCanceled Then Exit For
            ' call recursively this routine
            TraverseDirectoryTree(dirName, callback)
        Next

        nestLevel -= 1
        ' reset isCanceled if we are about to return to the user
        If nestLevel = 0 Then isCanceled = False
    End Sub

    Sub TestAPICallback()
        EnumWindows(AddressOf EnumWindows_CBK, 0)
    End Sub
End Module

' this module tests using callback delegates with Windows API calls

Module EnumWindowsDemo
    Delegate Function EnumWindows_Callback(ByVal hWnd As Integer, ByVal lParam As Integer) As Integer

    Public Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As EnumWindows_Callback, ByVal lParam As Integer) As Integer
    Public Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Integer, ByVal lpEnumFunc As EnumWindows_Callback, ByVal lParam As Integer) As Integer
    Public Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Integer, ByVal lpClassName As System.Text.StringBuilder, ByVal nMaxCount As Integer) As Integer
    Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Integer, ByVal lpString As System.Text.StringBuilder, ByVal cch As Integer) As Integer

    ' The callback routine, common to both EnumWindows and EnumChildWindows.
    ' the argument passed in lParam is the indent level.

    Function EnumWindows_CBK(ByVal hWnd As Integer, ByVal lParam As Integer) As Integer
        ' display information on this window, with correct indentation
        Console.WriteLine(New String(" "c, lParam * 3) & WindowDescription(hWnd))
        ' then display all child windows, but indent them to the right
        EnumChildWindows(hWnd, AddressOf EnumWindows_CBK, lParam + 1)
        ' Return 1 to continue enumeration.
        Return 1
    End Function

    ' return a windows description given its hWnd

    Function WindowDescription(ByVal hWnd As Integer) As String
        Dim text As String
        text = WindowText(hWnd)

        WindowDescription = "[" & Right$("0000000" & Hex$(hWnd), 8) & "] " _
            & WindowClassName(hWnd)
        If Len(text) > 0 Then
            WindowDescription &= " - """ & text & """"
        End If
    End Function

    ' Return the caption/text of a window.

    Function WindowText(ByVal hWnd As Integer) As String
        Dim buffer As New System.Text.StringBuilder(256)
        Dim length As Integer
        length = GetWindowText(hWnd, buffer, buffer.Capacity)
        WindowText = buffer.ToString.Substring(0, length)
    End Function

    Function WindowClassName(ByVal hWnd As Integer) As String
        Dim buffer As New System.Text.StringBuilder(256)
        Dim length As Integer
        length = GetClassName(hWnd, buffer, buffer.Capacity)
        WindowClassName = buffer.ToString.Substring(0, length)
    End Function

End Module